home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Info / For Developers / GhostScript 5.10 / MacGS-510 / files / gs_diskf.ps < prev    next >
Text File  |  1996-02-16  |  8KB  |  226 lines
  1. %    Copyright (C) 1996 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This file is part of Aladdin Ghostscript.
  4. % 
  5. % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  6. % or distributor accepts any responsibility for the consequences of using it,
  7. % or for whether it serves any particular purpose or works at all, unless he
  8. % or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  9. % License (the "License") for full details.
  10. % 
  11. % Every copy of Aladdin Ghostscript must include a copy of the License,
  12. % normally in a plain ASCII text file named PUBLIC.  The License grants you
  13. % the right to copy, modify and redistribute Aladdin Ghostscript, but only
  14. % under certain conditions described in the License.  Among other things, the
  15. % License requires that the copyright notice and this notice be preserved on
  16. % all copies.
  17.  
  18. % Support for converting Type 1 fonts without eexec encryption to
  19. % Type 4 fonts that load individual character outlines on demand.
  20.  
  21. % If DISKFONTS is true, we load individual CharStrings as they are needed.
  22. % (This is intended primarily for machines with very small memories.)
  23. % Initially, the character definition is the file position of the definition;
  24. % this gets replaced with the actual CharString.
  25. % Note that if we are loading characters lazily, CharStrings is writable.
  26.  
  27. % _Cstring must be long enough to hold the longest CharString for
  28. % a character defined using seac.  This is lenIV + 4 * 5 (for the operands
  29. % of sbw, assuming div is not used) + 2 (for sbw) + 3 * 5 (for the operands
  30. % of seac other than the character codes) + 2 * 2 (for the character codes)
  31. % + 2 (for seac), i.e., lenIV + 43.
  32.  
  33. /_Cstring 60 string def
  34.  
  35. % When we initially load the font, we call
  36. %    <index|charname> <length> <readproc> cskip_C
  37. % to skip over each character definition and return the file position instead.
  38. % This substitutes for the procedure
  39. %    <index|charname> <length> string currentfile exch read[hex]string pop
  40. %      [encrypt]
  41. % What we actually store in the CharString is fileposition * 1000 + length,
  42. %   negated if the string is stored in binary form.
  43.  
  44. /cskip_C
  45.  { exch dup 1000 ge 3 index type /nametype ne or
  46.     { % This is a Subrs string, or the string is so long we can't represent
  47.       % its length.  Load it now.
  48.       exch exec
  49.     }
  50.     { % Record the position and length, and skip the string.
  51.       dup currentfile fileposition 1000 mul add
  52.       2 index 3 get /readstring cvx eq { neg } if
  53.       3 1 roll
  54.       dup _Cstring length idiv
  55.        { currentfile _Cstring 3 index 3 get exec pop pop
  56.        } repeat
  57.       _Cstring length mod _Cstring exch 0 exch getinterval
  58.       currentfile exch 3 -1 roll 3 get exec pop pop
  59.     }
  60.    ifelse
  61.  } bind def
  62.  
  63. % Load a CharString from the file.  The font is the top entry
  64. % on the dictionary stack.
  65. /load_C        % <charname> <fileposandlength> load_C -
  66.  { dup abs 1000 idiv FontFile exch setfileposition
  67.    CharStrings 3 1 roll
  68.    .currentglobal CharStrings .gcheck .setglobal exch
  69.    dup 0 lt
  70.     { neg 1000 mod string FontFile exch readstring }
  71.     { 1000 mod string FontFile exch readhexstring }
  72.    ifelse pop
  73.    exch .setglobal
  74. % If the CharStrings aren't encrypted on the file, encrypt now.
  75.    Private /-| get 0 get
  76.    dup type /nametype ne
  77.     { dup length 5 sub 5 exch getinterval exec }
  78.     { pop }
  79.    ifelse dup 4 1 roll put
  80. % If the character is defined with seac, load its components now.
  81.    mark exch seac_C
  82.    counttomark
  83.     { StandardEncoding exch get dup CharStrings exch get
  84.       dup type /integertype eq { load_C } { pop pop } ifelse
  85.     } repeat
  86.    pop        % the mark
  87.  } bind def
  88.  
  89. /seac_C        % <charstring> seac_C <achar> <bchar> ..or nothing..
  90.  { dup length _Cstring length le
  91.     { 4330 exch _Cstring .type1decrypt exch pop
  92.       dup dup length 2 sub 2 getinterval <0c06> eq    % seac
  93.        { dup length
  94.          Private /lenIV known { Private /lenIV get } { 4 } ifelse
  95.      exch 1 index sub getinterval
  96. % Parse the string just enough to extract the seac information.
  97. % We assume that the only possible operators are hsbw, sbw, and seac,
  98. % and that there are no 5-byte numbers.
  99.      mark 0 3 -1 roll
  100.       { exch
  101.          { { dup 32 lt
  102.               { pop 0 }
  103.           { dup 247 lt
  104.              { 139 sub 0 }
  105.              { dup 251 lt
  106.             { 247 sub 256 mul 108 add 1 1 }
  107.             { 251 sub -256 mul -108 add -1 1 }
  108.                ifelse
  109.              }
  110.             ifelse
  111.           }
  112.          ifelse
  113.            }            % 0
  114.            { mul add 0 }        % 1
  115.          }
  116.         exch get exec
  117.       }
  118.      forall pop
  119.      counttomark 1 add 2 roll cleartomark    % pop all but achar bchar
  120.        }
  121.        { pop    % not seac
  122.        }
  123.       ifelse
  124.     }
  125.     { pop    % punt
  126.     }
  127.    ifelse
  128.  } bind def
  129.  
  130. % Define replacement procedures for loading fonts.
  131. % If DISKFONTS is true and the body of the font is not encrypted with eexec:
  132. %    - Prevent the CharStrings from being made read-only.
  133. %    - Substitute a different CharString-reading procedure.
  134. % (eexec disables this because the implicit 'systemdict begin' hides
  135. % the redefinitions that make the scheme work.)
  136. % We assume that:
  137. %    - The magic procedures (-|, -!, |-, and |) are defined with
  138. %    executeonly or readonly;
  139. %    - The contents of the reading procedures are as defined in bdftops.ps;
  140. %    - The font includes the code
  141. %    <font> /CharStrings <CharStrings> readonly put
  142. /.loadfontdict 6 dict def mark
  143.  /begin            % push this dict after systemdict
  144.   { dup begin
  145.     //systemdict eq { //.loadfontdict begin } if
  146.   } bind
  147.  /end            % match begin
  148.   { currentdict end
  149.     //.loadfontdict eq currentdict //systemdict eq and { end } if
  150.   } bind
  151.  /dict            % leave room for FontFile, BuildChar, BuildGlyph
  152.   { 3 add dict
  153.   } bind
  154.  /executeonly        % for reading procedures
  155.   { readonly
  156.   }
  157.  /noaccess        % for Subrs strings and Private dictionary
  158.   { readonly
  159.   }
  160.  /readonly        % for procedures and CharStrings dictionary
  161.   {    % We want to take the following non-standard actions here:
  162.       %   - If the operand is the CharStrings dictionary, do nothing;
  163.     %   - If the operand is a number (a file position replacing the
  164.     %    actual CharString), do nothing;
  165.     %   - If the operand is either of the reading procedures (-| or -!),
  166.     %    substitute a different one.
  167.     dup type /dicttype eq        % CharStrings or Private
  168.     count 2 gt and
  169.      { 1 index /CharStrings ne { readonly } if }
  170.      { dup type /arraytype eq        % procedure or data array
  171.     { dup length 5 ge 1 index xcheck and
  172.        { dup 0 get /string eq
  173.          1 index 1 get /currentfile eq and
  174.          1 index 2 get /exch eq and
  175.          1 index 3 get dup /readstring eq exch /readhexstring eq or and
  176.          1 index 4 get /pop eq and
  177.           { /cskip_C cvx 2 packedarray cvx
  178.           }
  179.           { readonly
  180.           }
  181.          ifelse
  182.        }
  183.        { readonly
  184.        }
  185.       ifelse
  186.     }
  187.     { dup type /stringtype eq    % must be a Subr string
  188.        { readonly }
  189.       if
  190.     }
  191.        ifelse
  192.      }
  193.     ifelse
  194.   } bind
  195.  /definefont        % to insert BuildChar/Glyph and change FontType
  196.   { dup /FontType get 1 eq
  197.      { dup /FontType 4 put
  198.        dup /BuildChar /build_C load put
  199.        dup /BuildGlyph /build_C load put
  200.      }
  201.     if definefont
  202.   } bind
  203. counttomark 2 idiv { .loadfontdict 3 1 roll put } repeat pop
  204. .loadfontdict readonly pop
  205.  
  206. % Define the BuildChar and BuildGlyph procedures for modified fonts.
  207. % A single procedure serves for both.
  208. /build_C        % <font> <code|name> build_C -
  209.  { 1 index begin
  210.    dup dup type /integertype eq { Encoding exch get } if
  211.         % Stack: font code|name name
  212.    dup CharStrings exch .knownget not
  213.     { 2 copy eq { exch pop /.notdef exch } if
  214.       QUIET not
  215.        { (Substituting .notdef for ) print = flush }
  216.        { pop }
  217.       ifelse
  218.       /.notdef CharStrings /.notdef get
  219.     } if
  220.         % Stack: font code|name name charstring   
  221.    dup type /integertype eq
  222.     { load_C end build_C }
  223.     { end .type1execchar }
  224.    ifelse
  225.  } bind def
  226.